home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / files.swg / 0105_Gather files into an archive.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-30  |  22.7 KB  |  821 lines
  1.  
  2. {
  3. Hello Gayle!
  4.  
  5. As I was working on an installation program and needed build-in
  6. compression/decompression I found out the sources available in SWAG only
  7. handled one file at a time thus couldn't create archives. So I created a
  8. little utility to gather several file into one with the ability to
  9. seperate them again.
  10.  
  11. It can be used for several other things. Just a few weeks ago I presented
  12. this as a solution to a guy who wanted to create one resource file from
  13. several datafiles. So I think this might be usefull enough for SWAG :))
  14.  
  15. ..SWG to include it in: FILES.SWG
  16. Subject proposal: Gather several file into one
  17.  
  18. The .pas files:
  19. --------------------------------------------------------- }
  20. PROGRAM Gather;  { program to extract files at the end !! }
  21.  
  22. {Gather v. 1.2
  23.  
  24. Archive several file in one, still being able to restore the original
  25. files.
  26.  
  27. Copyright 1996-97 Centennial Innovations by Bruno Olsen,
  28. All rights reserved.
  29.  
  30. LICENCE:
  31.  
  32. 1. You can distribute this program as long as no fee is charged. 2. You
  33. can use this source free of charge as long as you agree to 3-5. 3. If
  34. using this source, you must notify the auther. This will incurrage
  35.    the auther to update the source, and the auther will know if his
  36. effords
  37.    was worth while.
  38. 4. If modifying this source, you must notify the original auther about the
  39.    modifications, and send the full modified source. NOTE: Send ONLY the
  40. source
  41.    for THIS program, NOT the source of the program in which this source is
  42. used. 5. This source may be used in either freeware, shareware or
  43. commercial 
  44.    applications, as long as the author is familiar with the use, see 3-4.
  45.  
  46. Author can be contacted through these sources:
  47.  
  48. Bulletin Board: Mountain Online Services
  49.                 +45 58841025, +45 58841024
  50.  
  51. FidoNet: 2:236/42, 2:236/49
  52.  
  53. Internet: bo@vestnet.dk
  54.  
  55. Homepage: http://home.vest.net/bo
  56.  
  57. Snail mail: Centennial Innovations
  58.             Bruno Olsen
  59.             Fugleveanget 30
  60.             DK-4270 Hoeng
  61.             Denmark
  62.  
  63. History:
  64. Version 1.0    First usable version. Only files with the Archive attribute
  65.                set is archived.
  66. Version 1.2    Extended header to hold attribute information. Directories
  67. are
  68.                now stored and the files within are too. Limitation of
  69. Archive
  70.                files eliminated. Changes in header: Attrib added, DirNum
  71.                added and Numbers changed from Byte to Integer. Rewritten
  72.                most of the code to recursive rutines.}
  73.  
  74. USES DOS, CRT;
  75.  
  76. TYPE HeaderType=RECORD
  77.                  Str:String[12];
  78.                                 {Record 0: Identifying string='GTH_2'
  79.                                  Record 1 and above: File/directory name}
  80.                  Attrib:Array [1..5] of Boolean;
  81.                                 {Attrib: 1   true if   System
  82.                                          2   true if   Hidden
  83.                                          3   true if   Archive
  84.                                          4   true if   ReadOnly
  85.                                          5   true if   Directory}
  86.                  Numbers:Integer;
  87.                                 {Numbers:
  88.                                  Record 0: Amount of files stored.
  89.                                  Record 1 and above: The number of the
  90.                                                      directory.
  91.                                                      The root gather
  92.                                                      directory is 0.
  93.                                  NOT used for files.}
  94.                  DirNum:Integer;
  95.                                 {DirNum:
  96.                                  Record 0: Amount of directories stored.
  97.                                  Record 1 and above: The number of the
  98.                                                      directory the files/
  99.                                                      directories reside
  100. in.
  101.                                                      The root gather
  102.                                                      directory is 0.}
  103.                  Offsets:LongInt;
  104.                                 {Offsets:
  105.                                  Record 0: Where the header ends.
  106.                                  Record 1 and above: Where the current
  107. file
  108.                                                      processed ends.
  109. Previous
  110.                                                      + 1 marks file
  111. start.}
  112.                 END;
  113.  
  114. CONST RecordSize=26;  {The size of header type. Edit this when modifying
  115. header}
  116.       HeaderName='GTH_2';
  117.       VersionNumber='1.2';
  118.       CYear='1996-97';
  119.  
  120. VAR InFiles,
  121.     OutFile:File;
  122.     MainFile:File of HeaderType;
  123.     Main:HeaderType;
  124.     MaxFiles:Byte;
  125.     Last:Byte;
  126.     NumRead, NumWritten: Word;
  127.     Buf: array[1..4000] of Char;
  128.     FSize:LongInt;
  129.     Error:Word;
  130.     TempSize,
  131.     SizeCount:LongInt;
  132.     FileCount,
  133.     DirCount:Integer;
  134.     DirInfo:SearchRec;
  135.     CurrentDir,
  136.     LastDir,
  137.     DirNum,
  138.     InDirNum:Integer;
  139.     StartDir,
  140.     GatherDir,
  141.     GatherFiles,
  142.     GatherTo,
  143.     ConvStr,
  144.     EnvTemp:String;
  145.     ProcDir:Boolean;
  146.  
  147. PROCEDURE Get_File_Size(FName : string;
  148.                     var FSize : longint;
  149.                     var Error : word);
  150. var
  151.   SR    : SearchRec;
  152.  
  153. BEGIN 
  154.   {$I-}
  155.   FindFirst(FName,Archive,SR);
  156.   Error := DosError;
  157.   {$I+}
  158.   if Error = 0 then
  159.     FSize := SR.Size
  160.   else
  161.     FSize := 0;
  162. END;
  163.  
  164. PROCEDURE CountFiles(VAR DirCount, FileCount:Integer;VAR
  165. SizeCount:LongInt);
  166.  
  167. VAR LastDir:String;
  168.  
  169.  BEGIN
  170.   FindFirst(GatherFiles, AnyFile-VolumeID, DirInfo);
  171.   while DosError = 0 do
  172.    begin
  173.     IF (DirInfo.Attr=Directory) AND NOT((DirInfo.Name='.') OR
  174. (DirInfo.Name='..')) THEN
  175.      BEGIN
  176.       DirCount:=DirCount+1;
  177.       ChDir(DirInfo.Name);
  178.       LastDir:=DirInfo.Name;
  179.       CountFiles(DirCount,FileCount,SizeCount);
  180.       ChDir('..');
  181.       FindFirst('*.*', AnyFile-VolumeID, DirInfo); { Same as DIR *.PAS }
  182.       while (DosError = 0) AND NOT(DirInfo.Name=LastDir) do
  183.        begin
  184.         FindNext(DirInfo);
  185.        end;
  186.      END
  187.      ELSE
  188.       IF DirInfo.Attr IN[Archive,ReadOnly,Hidden,SysFile] THEN
  189.        BEGIN
  190.         FileCount:=FileCount+1;
  191.         SizeCount:=SizeCount+DirInfo.Size;
  192.        END;
  193.     FindNext(DirInfo);
  194.    end;
  195.  END;
  196.  
  197. PROCEDURE ResetAttrib;
  198.  
  199.  VAR Counter:Integer;
  200.  
  201. BEGIN
  202.  FOR Counter:=1 to 5 DO
  203.   Main.Attrib[Counter]:=False;
  204. END;
  205.  
  206. PROCEDURE SetAttrib;
  207.  
  208.  VAR Check:Byte;
  209.  
  210. BEGIN
  211.  ResetAttrib;
  212.  Check:=DirInfo.Attr;
  213.  IF (Check-32) IN[0,1,2,4,8,16] THEN
  214.   BEGIN
  215.    Check:=Check-32;
  216.    Main.Attrib[3]:=TRUE;
  217.   END;
  218.  IF (Check-16) IN[0,1,2,4,8] THEN
  219.   BEGIN
  220.    Check:=Check-16;
  221.    Main.Attrib[5]:=TRUE;
  222.   END;
  223.  IF (Check-8) IN[0,1,2,4] THEN
  224.   BEGIN
  225.    Check:=Check-8;    {VolumeID is not used}
  226.   END;
  227.  IF (Check-4) IN[0,1,2] THEN
  228.   BEGIN
  229.    Check:=Check-4;
  230.    Main.Attrib[1]:=TRUE;
  231.   END;
  232.  IF (Check-2) IN[0,1] THEN
  233.   BEGIN
  234.    Check:=Check-2;
  235.    Main.Attrib[2]:=TRUE;
  236.   END;
  237.  IF Check-1=0 THEN
  238.   BEGIN
  239.    Main.Attrib[4]:=TRUE;
  240.   END;
  241. END;
  242.  
  243. PROCEDURE AddFile;
  244. BEGIN
  245.  Assign(InFiles,DirInfo.Name);
  246.  Reset(InFiles,1);
  247.  repeat
  248.   BlockRead(InFiles, Buf, SizeOf(Buf), NumRead);
  249.   BlockWrite(OutFile, Buf, NumRead, NumWritten);
  250.  until (NumRead = 0) or (NumWritten <> NumRead);
  251.  Close(InFiles);
  252. END;
  253.  
  254. PROCEDURE MakeHeader(LastDir:Integer;VAR CurrentDir:Integer);
  255.  
  256. VAR LastDirName:String;
  257.  
  258.  BEGIN
  259.   FindFirst(GatherFiles, AnyFile-VolumeID, DirInfo);
  260.   while DosError = 0 do
  261.    begin
  262.     IF (DirInfo.Attr=Directory) AND NOT((DirInfo.Name='.') OR
  263. (DirInfo.Name='..')) THEN
  264.      BEGIN
  265.       CurrentDir:=CurrentDir+1;
  266.       DirNum:=CurrentDir;
  267.       InDirNum:=LastDir;
  268.       ChDir(DirInfo.Name);
  269.       LastDirName:=DirInfo.Name;
  270.       Main.Str:=DirInfo.Name;
  271.       WriteLn('Storing directory: '+DirInfo.Name);
  272.       SetAttrib;
  273.       Main.Numbers:=DirNum;
  274.       Main.DirNum:=InDirNum;
  275.       Main.Offsets:=0;
  276.       Write(MainFile,Main);
  277.       MakeHeader(CurrentDir,CurrentDir);
  278.       ChDir('..');
  279.       FindFirst('*.*', AnyFile-VolumeID, DirInfo);
  280.       while (DosError = 0) AND NOT(DirInfo.Name=LastDirName) do
  281.        begin
  282.         FindNext(DirInfo);
  283.        end;
  284.      END
  285.      ELSE IF (DirInfo.Attr<>Directory) AND (DirInfo.Attr<>VolumeID) THEN
  286.       BEGIN
  287.        Main.Str:=DirInfo.Name;
  288.        WriteLn('Storing file: '+DirInfo.Name);
  289.        SetAttrib;
  290.        Main.Numbers:=DirNum;
  291.        Main.DirNum:=InDirNum;
  292.        Main.Offsets:=TempSize+DirInfo.Size;
  293.        TempSize:=Main.Offsets;
  294.        AddFile;
  295.        Write(MainFile,Main);
  296.       END;
  297.     FindNext(DirInfo);
  298.    end;
  299.  END;
  300.  
  301. PROCEDURE GetParams;
  302.  
  303. VAR Counter:Integer;
  304.  
  305.  BEGIN
  306.   ProcDir:=FALSE;
  307.   IF ParamCount=0 THEN
  308.    BEGIN
  309.     WriteLn('Usage:');
  310.     WriteLn('GATHER [ -d | -D ] [DirectoryName] InFiles OutFile');
  311.     WriteLn;
  312.     WriteLn('-d or -D     : Gather files and directory structure');
  313.     WriteLn('DirectoryName: Starting directory');
  314.     WriteLn('InFiles      : Files to gather');
  315.     WriteLn('OutFile      : File to gather the files into');
  316.     WriteLn;
  317.     WriteLn('Examples:');
  318.     WriteLn('GATHER *.PAS PASFILES.GTH    Gather all .PAS-files into the file PASFILES.GTH');
  319.     WriteLn('GATHER -D c:\dos *.* DOSDIR.GTH  GATHER all files in c:\dos and all directories');
  320.     WriteLn('                                 and all files in them into the file DOSDIR.GTH');
  321.     Halt(1);
  322.    END
  323.    ELSE
  324.     BEGIN
  325.      Counter:=1;
  326.      IF (ParamStr(Counter)='-d') OR (ParamStr(Counter)='-D') THEN
  327.       BEGIN
  328.        ProcDir:=TRUE;
  329.        Counter:=Counter+1;
  330.       END;
  331.      IF (ParamCount-Counter)=2 THEN
  332.       BEGIN
  333.        GatherDir:=ParamStr(Counter);
  334.        Counter:=Counter+1;
  335.       END
  336.       ELSE
  337.        GatherDir:=StartDir;
  338.      GatherFiles:=ParamStr(Counter);
  339.      GatherTo:=ParamStr(Counter+1);
  340.     END;
  341.  END;
  342.  
  343. BEGIN
  344.  CLRSCR;
  345.  WriteLn('Gather version '+VersionNumber+' (C) '+CYear+' Centennial Innovations by Bruno Olsen');
  346.  WriteLn;
  347.  GetDir(0,StartDir); { 0 = Current drive }
  348.  EnvTemp:=GetEnv('TEMP');
  349.  EnvTemp:=EnvTemp+'\';
  350.  DirCount:=0;FileCount:=0;SizeCount:=0;
  351.  GetParams;
  352.  ChDir(GatherDir);
  353.  Write('Analizing... ');
  354.  CountFiles(DirCount,FileCount,SizeCount);
  355.  Str(DirCount,ConvStr);
  356.  Write('Directories: '+ConvStr);
  357.  Str(FileCount,ConvStr);
  358.  Write(' Files: '+ConvStr);
  359.  Str(SizeCount,ConvStr);
  360.  WriteLn(' Bytes: '+ConvStr);
  361.  WriteLn;
  362.  WriteLn('Processing...');
  363.  ChDir(StartDir);
  364.  MaxFiles:=DirCount+FileCount;
  365.  ResetAttrib;
  366.  Main.Str:=HeaderName;
  367.  Main.Numbers:=FileCount;
  368.  Main.DirNum:=DirCount;
  369.  Main.Offsets:=RecordSize*(MaxFiles+1);
  370.  TempSize:=Main.Offsets;
  371.  Assign(MainFile,EnvTemp+'head.tmp');
  372.  Assign(OutFile,EnvTemp+'main.tmp');
  373.  ReWrite(MainFile);
  374.  ReWrite(OutFile);
  375.  Close(OutFile);
  376.  Reset(OutFile,1);
  377.  Write(MainFile,Main);
  378.  CurrentDir:=0;LastDir:=0;
  379.  ChDir(GatherDir);
  380.  MakeHeader(LastDir,CurrentDir);
  381.  ChDir(StartDir);
  382.  Close(MainFile);
  383.  Close(OutFile);
  384.  WriteLn;
  385.  WriteLn('Cleaning up...');
  386.  Assign(InFiles,EnvTemp+'head.tmp');
  387.  Assign(OutFile,GatherTo);
  388.  ReWrite(OutFile);
  389.  Close(OutFile);
  390.  Reset(InFiles,1);
  391.  Reset(OutFile,1);
  392.  repeat
  393.    BlockRead(InFiles, Buf, SizeOf(Buf), NumRead);
  394.    BlockWrite(OutFile, Buf, NumRead, NumWritten);
  395.   until (NumRead = 0) or (NumWritten <> NumRead);
  396.  Close(InFiles);
  397.  Close(OutFile);
  398.  Assign(InFiles,EnvTemp+'main.tmp');
  399.  Assign(OutFile,GatherTo);
  400.  Reset(InFiles,1);
  401.  Reset(OutFile,1);
  402.  Seek(OutFile,FileSize(OutFile));
  403.  repeat
  404.    BlockRead(InFiles, Buf, SizeOf(Buf), NumRead);
  405.    BlockWrite(OutFile, Buf, NumRead, NumWritten);
  406.   until (NumRead = 0) or (NumWritten <> NumRead);
  407.  Close(InFiles);
  408.  Close(OutFile);
  409.  Erase(InFiles);
  410.  Assign(Infiles,EnvTemp+'head.tmp');
  411.  Erase(Infiles);
  412.  ChDir(StartDir);
  413.  WriteLn('Done.');
  414. END.
  415. ---------------------------------------------------------
  416. PROGRAM XTract;
  417.  
  418. {Xtract v. 1.2
  419.  
  420. Restore files Gathered with Gather v. 1.2.
  421.  
  422. Copyright 1996-97 Centennial Innovations by Bruno Olsen,
  423. All rights reserved.
  424.  
  425. LICENCE:
  426.  
  427. 1. You can distribute this program as long as no fee is charged. 2. You
  428. can use this source free of charge as long as you agree to 3-5. 3. If
  429. using this source, you must notify the auther. This will incurrage
  430.    the auther to update the source, and the auther will know if his
  431. effords
  432.    was worth while.
  433. 4. If modifying this source, you must notify the original auther about the
  434.    modifications, and send the full modified source. NOTE: Send ONLY the
  435. source
  436.    for THIS program, NOT the source of the program in which this source is
  437. used. 5. This source may be used in either freeware, shareware or
  438. commercial 
  439.    applications, as long as the author is familiar with the use, see 3-4.
  440.  
  441. Author can be contacted through these sources:
  442.  
  443. Bulletin Board: Mountain Online Services
  444.                 +45 58841025, +45 58841024
  445.  
  446. FidoNet: 2:236/42, 2:236/49
  447.  
  448. Internet: bo@vestnet.dk
  449.  
  450. Homepage: http://home.vest.net/bo
  451.  
  452. Snail mail: Centennial Innovations
  453.             Bruno Olsen
  454.             Fugleveanget 30
  455.             DK-4270 Hoeng
  456.             Denmark
  457.  
  458. History:
  459. Version 1.0    First usable version. Only files with the Archive attribute
  460.                set is archived.
  461. Version 1.2    Extended header to hold attribute information. Directories
  462. are
  463.                now stored and the files within are too. Limitation of
  464. Archive
  465.                files eliminated. Changes in header: Attrib added, DirNum
  466.                added and Numbers changed from Byte to Integer. Rewritten
  467.                most of the code.}
  468.  
  469. USES DOS, CRT;
  470.  
  471. TYPE HeaderType=RECORD
  472.                  Str:String[12];
  473.                                 {Record 0: Identifying string='GTH_2'
  474.                                  Record 1 and above: File/directory name}
  475.                  Attrib:Array [1..5] of Boolean;
  476.                                 {Attrib: 1   true if   System
  477.                                          2   true if   Hidden
  478.                                          3   true if   Archive
  479.                                          4   true if   ReadOnly
  480.                                          5   true if   Directory}
  481.                  Numbers:Integer;
  482.                                 {Numbers:
  483.                                  Record 0: Amount of files stored.
  484.                                  Record 1 and above: The number of the
  485.                                                      directory.
  486.                                                      The root gather
  487.                                                      directory is 0.
  488.                                  NOT used for files.}
  489.                  DirNum:Integer;
  490.                                 {DirNum:
  491.                                  Record 0: Amount of directories stored.
  492.                                  Record 1 and above: The number of the
  493.                                                      directory the files/
  494.                                                      directories reside
  495. in.
  496.                                                      The root gather
  497.                                                      directory is 0.}
  498.                  Offsets:LongInt;
  499.                                 {Offsets:
  500.                                  Record 0: Where the header ends.
  501.                                  Record 1 and above: Where the current
  502. file
  503.                                                      processed ends.
  504. Previous
  505.                                                      + 1 marks file
  506. start.} {                 Compressed:Boolean;}
  507.                                 {Compressed:
  508.                                  TRUE if the file was compressed,
  509.                                  FALSE if the file was stored.}
  510.                 END;
  511.  
  512. CONST RecordSize=26;
  513.       HeaderName='GTH_2';
  514.       VersionNumber='1.2';
  515.       CYear='1996-97';
  516.  
  517. VAR InFiles,
  518.     OutFile:File;
  519.     MainFile,
  520.     HeadTemp:File of HeaderType;
  521.     Main:HeaderType;
  522.     Head:HeaderType;
  523.     MaxFiles:Byte;
  524.     Last:Byte;
  525.     NumRead, NumWritten: Word;
  526.     Buf: array[1..2048] of Char;
  527.     FSize,
  528.     Missing,
  529.     EndSize:LongInt;
  530.     Error:Word;
  531.     TempSize,
  532.     SizeCount:LongInt;
  533.     FileCount,
  534.     DirCount:Integer;
  535.     DirInfo:SearchRec;
  536.     CurrentDir,
  537.     LastDir,
  538.     DirNum,
  539.     InDirNum:Integer;
  540.     StartDir,
  541.     XtractDir,
  542.     XtractFrom,
  543.     XtractFiles,
  544.     ConvStr,
  545.     EnvTemp:String;
  546.     ProcDir:Boolean;
  547.  
  548. PROCEDURE Get_File_Size(FName : string;
  549.                     var FSize : longint;
  550.                     var Error : word);
  551. var
  552.   SR    : SearchRec;
  553.  
  554. BEGIN
  555.   {$I-}
  556.   FindFirst(FName,Archive,SR);
  557.   Error := DosError;
  558.   {$I+}
  559.   if Error = 0 then
  560.     FSize := SR.Size
  561.   else
  562.     FSize := 0;
  563. END; 
  564.  
  565. Function DirExist(st_Dir : DirStr) : Boolean;
  566. Var
  567.   wo_Fattr : Word;
  568.   fi_Temp  : File;
  569. begin
  570.   assign(fi_Temp, (st_Dir + '.'));
  571.   getfattr(fi_Temp, wo_Fattr);
  572.   if (Doserror <> 0) then
  573.     DirExist := False
  574.   else
  575.     DirExist := ((wo_Fattr and directory) <> 0)
  576. end; 
  577.  
  578. PROCEDURE CountFiles(VAR DirCount, FileCount:Integer;VAR
  579. SizeCount:LongInt);
  580.  
  581. VAR LastDir:String;
  582.     Counter:Integer;
  583.  
  584.  BEGIN
  585.   Get_File_Size(XtractFrom,FSize,Error);
  586.   Assign(MainFile,XtractFrom);
  587.   Reset(MainFile);
  588.   Assign(HeadTemp,EnvTemp+'head.tmp');
  589.   ReWrite(HeadTemp);
  590.   Read(MainFile,Main);
  591.   MaxFiles:=Main.Numbers+Main.DirNum;
  592.   TempSize:=RecordSize*(Maxfiles+1);
  593.   SizeCount:=FSize-TempSize;
  594.   DirCount:=Main.DirNum;
  595.   FileCount:=Main.Numbers;
  596.   Write(HeadTemp,Main);
  597.   FOR Counter:=1 TO MaxFiles DO
  598.    BEGIN
  599.     Read(MainFile,Main);
  600.     Write(HeadTemp,Main);
  601.    END;
  602.   Close(MainFile);
  603.   Close(HeadTemp);
  604.   Assign(MainFile,EnvTemp+'head.tm2');
  605.   Reset(HeadTemp);
  606.   ReWrite(MainFile);
  607.   While NOT(EOF(HeadTemp)) DO
  608.    BEGIN
  609.     Read(HeadTemp,Main);
  610.     Write(MainFile,Main);
  611.    END;
  612.  END;
  613.  
  614. PROCEDURE ResetAttrib;
  615.  
  616.  VAR Counter:Integer;
  617.  
  618. BEGIN
  619.  FOR Counter:=1 to 5 DO
  620.   Main.Attrib[Counter]:=False;
  621. END;
  622.  
  623. PROCEDURE SetAttrib;
  624.  
  625.  VAR Check:Word;
  626.  
  627. BEGIN
  628.  Check:=0;
  629.  IF Main.Attrib[3]=TRUE THEN
  630.    Check:=Check+Archive;
  631.  IF Main.Attrib[1]=TRUE THEN
  632.    Check:=Check+SysFile;
  633.  IF Main.Attrib[2]=TRUE THEN
  634.    Check:=Check+Hidden;
  635.  IF Main.Attrib[4]=TRUE THEN
  636.    Check:=Check+ReadOnly;
  637.  SetFAttr(OutFile,Check);
  638. END;
  639.  
  640. PROCEDURE MakeFile;
  641. BEGIN
  642.  Write('Xtracting file: '+Main.Str+' ');
  643.  Assign(OutFile,Main.Str);
  644.  ReWrite(OutFile);
  645.  Close(OutFile);
  646.  EndSize:=Main.Offsets-TempSize;
  647.  IF EndSize>2048 THEN
  648.   BEGIN
  649.    repeat
  650.     BlockRead(InFiles, Buf, SizeOf(Buf), NumRead);
  651.     Reset(OutFile,1);
  652.     Seek(OutFile,FileSize(OutFile));
  653.     BlockWrite(OutFile, Buf, NumRead, NumWritten);
  654.     Close(OutFile);
  655.     Get_File_Size(Main.Str,FSize,Error);
  656.    until (EndSize-FSize)<2048;
  657.    Missing:=EndSize-FSize;
  658.   END ELSE Missing:=EndSize;
  659.  BlockRead(InFiles,Buf,Missing,NumRead);
  660.  Reset(OutFile,1);
  661.  Seek(OutFile,FileSize(OutFile));
  662.  BlockWrite(OutFile,Buf,Missing,NumWritten);
  663.  Close(OutFile);
  664.  SetAttrib;
  665.  WriteLn('Ok');
  666. END;
  667.  
  668. PROCEDURE ReadHeader(LastDir:Integer;VAR CurrentDir:Integer);
  669.  
  670. VAR LastDirName:String;
  671.     Counter:Integer;
  672.     DoneThis:Boolean;
  673.  
  674.  BEGIN
  675.   Assign(HeadTemp,EnvTemp+'head.tm2');
  676.   CurrentDir:=0;
  677.   Counter:=1;
  678.   While NOT(EOF(MainFile)) DO
  679.    BEGIN
  680.     Read(MainFile,Main);
  681.     IF Main.Attrib[5] THEN
  682.      BEGIN
  683.       Write('Xtracting directory: '+Main.Str+' ');
  684.       IF Main.DirNum=CurrentDir THEN
  685.        BEGIN
  686.         IF NOT(DirExist(Main.Str)) THEN MkDir(Main.Str);
  687.         ChDir(Main.Str);
  688.         CurrentDir:=Main.Numbers;
  689.         Counter:=Counter+1;
  690.         WriteLn('Ok');
  691.        END
  692.         ELSE
  693.          BEGIN
  694.           Write('Searching... ');
  695.           LastDir:=CurrentDir;
  696.           REPEAT
  697.            Reset(HeadTemp);
  698.            Read(HeadTemp,Head);
  699.            While NOT(EOF(HeadTemp)) DO
  700.             BEGIN
  701.              Read(HeadTemp,Head);
  702.              IF (Head.Numbers=LastDir) AND (Head.Attrib[5]) THEN
  703.               BEGIN
  704.                ChDir('..');
  705.                LastDir:=Head.DirNum;
  706.                Counter:=Counter+1;
  707.               END;
  708.             END;
  709.           UNTIL LastDir=Main.DirNum;
  710.           IF NOT(DirExist(Main.Str)) THEN MkDir(Main.Str);
  711.           ChDir(Main.Str);
  712.           CurrentDir:=Main.Numbers;
  713.           Counter:=Counter+1;
  714.           WriteLn('Ok');
  715.          END;
  716.      END
  717.      ELSE
  718.       BEGIN
  719.        MakeFile;
  720.        TempSize:=Main.Offsets;
  721.      END;
  722.    END;
  723.  END;
  724.  
  725. PROCEDURE GetParams;
  726.  
  727. VAR Counter:Integer;
  728.  
  729.  BEGIN
  730.   ProcDir:=FALSE;
  731.   IF ParamCount=0 THEN
  732.    BEGIN
  733.     WriteLn('Usage:');
  734.     WriteLn('XTRACT [ -d | -D ] [DirectoryName] InFile OutFiles');
  735.     WriteLn;
  736.     WriteLn('-d or -D     : Gather files and directory structure');
  737.     WriteLn('DirectoryName: Starting directory');
  738.     WriteLn('InFile       : File to restore from');
  739.     WriteLn('OutFiles     : Files to restore');
  740.     WriteLn;
  741.     WriteLn('Examples:');
  742.     WriteLn('XTRACT PASFILES.GTH *.PAS    Gather all .PAS-files into the
  743. file PASFILES.GTH');
  744.     WriteLn('XTRACT -D c:\dos DOSDIR.GTH *.*  GATHER all files in c:\dos
  745. and all directories');
  746.     WriteLn('                                 and all files in them into
  747. the file DOSDIR.GTH');
  748.     Halt(1);
  749.    END
  750.    ELSE
  751.     BEGIN
  752.      Counter:=1;
  753.      IF (ParamStr(Counter)='-d') OR (ParamStr(Counter)='-D') THEN
  754.       BEGIN
  755.        ProcDir:=TRUE;
  756.        Counter:=Counter+1;
  757.       END;
  758.      IF (ParamCount-Counter)=2 THEN
  759.       BEGIN
  760.        XtractDir:=ParamStr(Counter);
  761.        Counter:=Counter+1;
  762.       END
  763.       ELSE
  764.        XtractDir:=StartDir;
  765.      XtractFrom:=ParamStr(Counter);
  766.      XtractFiles:=ParamStr(Counter+1);
  767.     END;
  768.  END;
  769.  
  770. BEGIN
  771.  CLRSCR;
  772.  WriteLn('Xtract version '+VersionNumber+' (C) '+CYear+' Centennial
  773. Innovations by Bruno Olsen');
  774.  WriteLn;
  775.  GetDir(0,StartDir); { 0 = Current drive }
  776.  EnvTemp:=GetEnv('TEMP');
  777.  EnvTemp:=EnvTemp+'\';
  778.  DirCount:=0;FileCount:=0;SizeCount:=0;
  779.  GetParams;
  780.  Write('Analizing... ');
  781.  CountFiles(DirCount,FileCount,SizeCount);
  782.  Str(DirCount,ConvStr);
  783.  Write('Directories: '+ConvStr);
  784.  Str(FileCount,ConvStr);
  785.  Write(' Files: '+ConvStr);
  786.  Str(SizeCount,ConvStr);
  787.  WriteLn(' Bytes: '+ConvStr);
  788.  WriteLn;
  789.  WriteLn('Processing...');
  790.  ResetAttrib;
  791.  Assign(MainFile,EnvTemp+'head.tmp');
  792.  Assign(InFiles,StartDir+'\'+XtractFrom);
  793.  Reset(MainFile);
  794.  Read(MainFile,Main);
  795.  Reset(InFiles,1);
  796.  Seek(Infiles,TempSize);
  797.  CurrentDir:=0;LastDir:=0;
  798.  IF NOT(DirExist(XtractDir)) THEN MkDir(XtractDir);
  799.  ChDir(XtractDir);
  800.  ReadHeader(LastDir,CurrentDir);
  801.  ChDir(StartDir);
  802.  Close(MainFile);
  803.  Close(InFiles);
  804.  WriteLn;
  805.  WriteLn('Cleaning up...');
  806.  Assign(InFiles,EnvTemp+'head.tmp');
  807.  Erase(InFiles);
  808.  ChDir(StartDir);
  809.  WriteLn('Done.');
  810. END.
  811. ---------------------------------------------------------
  812.  
  813. Hope you find it a good idea :))
  814.  
  815. ---------------------------------------------------------
  816. Regards,
  817.          Bruno Olsen
  818.          bo@vestnet.dk
  819.          HTTP://home.vest.net/bo
  820. ---------------------------------------------------------
  821.